module Arbol23 where

import Char


------------------------------------------------------------------------
---- Definición de la estructura del árbol. ----
------------------------------------------------------------------------

data Arbol23 a b = Hoja a | Dos b (Arbol23 a b) (Arbol23 a b) | 
                    Tres b b (Arbol23 a b) (Arbol23 a b) (Arbol23 a b)


------------------------------------------------------------------------
---- Funciones para mostrar el árbol. ----
------------------------------------------------------------------------

instance (Show a, Show b) => Show (Arbol23 a b) where
    show x = concatMap (++ "\n") (padTree 0 x)

padTree:: (Show a, Show b) => Int -> (Arbol23 a b) -> [String]
padTree i (Hoja x) = [(pad i) ++  (show x)]
padTree i (Dos x a1 a2) = [(pad i) ++  (show x) ] ++ 
                                (concatMap (padTree (i + 4)) [a1,a2])
padTree i (Tres x y a1 a2 a3) = [(pad i) ++  (show x) ++ 
            (' ':(show y))] ++ (concatMap (padTree (i + 4)) [a1,a2,a3])

pad:: Int -> String
pad i = replicate i ' '


------------------------------------------------------------------------
---- Funciones pedidas. ----
------------------------------------------------------------------------

---- Fold. ----
------------------------------------------------------------------------
---- El tipo de cada constructor + el tipo de la estructura +   ----
---- el tipo del resultado.                                     ----

foldA23:: (a -> b) -> (c -> b -> b -> b) -> (c -> c -> b -> b -> b -> b) 
            -> Arbol23 a c -> b
foldA23 casoHoja casoDos casoTres arbol = 
        case arbol of
            Hoja a              -> casoHoja a
            Dos  x a1 a2        -> casoDos x (rec a1) (rec a2)
            Tres x y a1 a2 a3   -> casoTres x y (rec a1) (rec a2) (rec a3)
            where rec   = foldA23 casoHoja casoDos casoTres


------------------------------------------------------------------------

---- Lista en preorden de los internos del árbol. ----
------------------------------------------------------------------------
---- Agregar los valores internos; y luego hacer append de los  ----
---- pasos recursivos.                                          ----
---- El caso base es una lista vacia porque L++[] = L ----

internos::Arbol23 a b->[b]
internos = foldA23 (const []) (\x f g -> x:(f++g)) 
                                (\x y f g h -> x:y:(f++g++h))


------------------------------------------------------------------------

---- Lista las hojas de izquierda a derecha. ----
------------------------------------------------------------------------
---- Parecido al anterior, sólo que se descartan los valores ---- 
---- internos, y el caso base es la función que devuelve el  ----
---- valor de la hoja como único elemento de una lista.      ----

hojas :: Arbol23 a b -> [a]
hojas = foldA23 (\x -> [x]) (\_ f g -> f++g) (\_ _ f g h -> f++g++h)


------------------------------------------------------------------------

---- Dice si un árbol es una hoja. ----
------------------------------------------------------------------------
---- Sólo se devuelve True cuando es hoja, se podia hacer con case  ----
---- pero está así para que quede un one-liner.                     ----
esHoja :: Arbol23 a b -> Bool
esHoja = foldA23 (const True) (\_ _ _ -> False) (\_ _ _ _ _ -> False)


------------------------------------------------------------------------

---- Map. ----
------------------------------------------------------------------------
---- Función sobre el primer tipo + función sobre el segundo tipo.  ----
---- Aplica la primera función a los elementos del primer tipo,     ----
---- y la segunda a los del segundo tipo. Devuelve otro árbol.      ----

mapA23 :: (a -> c) -> (b -> d) -> Arbol23 a b -> Arbol23 c d
mapA23 fHoja fNodo = foldA23 (\x -> Hoja (fHoja x)) (\x -> Dos (fNodo x)) 
                            (\x y -> Tres (fNodo x) (fNodo y))


---- Ejemplo de uso de mapA23. ----
---- Incrementa en 1 el valor de las hojas. ----
incrementarHojas :: Num a => Arbol23 a b -> Arbol23 a b
incrementarHojas = mapA23 (+1) id


------------------------------------------------------------------------

---- Fold para Naturales. ----
------------------------------------------------------------------------
foldNat :: (a -> a) -> a -> Integer -> a
foldNat f x 0 = x
foldNat f x n = f (foldNat f x (n-1))


------------------------------------------------------------------------

---- Truncar. ----
------------------------------------------------------------------------
---- Trunca el árbol hasta un determinado nivel.            ----
---- Cuando llega a 0, reemplaza el resto del árbol por     ----
---- una hoja con el valor indicado.                        ----
---- Funciona para árboles infinitos.                       ----

truncar :: a -> Integer -> Arbol23 a b -> Arbol23 a b
---- Algo que devuelve Arbol23 a b -> Arbol23 a b   ----
---- En este foldNat, el tipo a vendría a ser       ----
---- Arbol23 a b -> Arbol23 a b                     ----
---- truncar nuevaHoja :: ((Arbol23 a b -> Arbol23 a b) -> (Arbol23 a b -> Arbol23 a b)) -> (Arbol23 a b -> Arbol23 a b) -> Integer -> (Arbol23 a b -> Arbol23 a b)
---- Lo que hace es dejar el arbol en ese nivel como estaba,        ----
---- y aplicarle la función que se viene acumulando al resto.       ----
---- Cuando se llega a 0, se reemplazan los valores de las hojas.   ----

truncar nuevaHoja = foldNat (\f -> mapFun f) (\t -> Hoja nuevaHoja)

---- función sobre árboles que se aplica en todo el árbol   ----
---- menos en el nivel actual.                              ----

mapFun :: (Arbol23 a b -> Arbol23 a b) -> Arbol23 a b -> Arbol23 a b
mapFun f = foldA23 (\x -> Hoja x) (\x izq der -> Dos x (f izq) (f der))
        (\x y izq mid der -> Tres x y (f izq) (f mid) (f der))

------------------------------------------------------------------------

---- Identidad. ----
------------------------------------------------------------------------

idA23 :: Arbol23 a b -> Arbol23 a b
idA23 = mapA23 (id) (id)


------------------------------------------------------------------------

---- Altura. ----
------------------------------------------------------------------------

altura :: Arbol23 a b -> Integer
altura = foldA23 (\hoja -> 0) (\x izq der-> 1 + max izq der) 
                 (\x y izq mid der -> 1 + max izq (max mid der))


------------------------------------------------------------------------

---- Evaluar. ----
------------------------------------------------------------------------
---- Evalúa las funciones tomando los valores de los hijos  ---- 
---- como argumentos.                                       ----
---- En el caso de que haya 3 hijos, asocia a izquierda.    ----
evaluar :: Arbol23 a (a -> a -> a) -> a
evaluar = foldA23 id (\x f g -> f `x` g) 
            (\x y f g h -> (f `x` g) `y` h) 





------------------------------------------------------------------------

---- Igualdad. ----
------------------------------------------------------------------------
---- Nada más se usa para testing. ----
instance (Eq a, Eq b) => Eq (Arbol23 a b) where
    (==) = foldA23 
            (\a arbol -> case arbol of
                Hoja b -> a == b
                Dos _ _ _ -> False
                Tres _ _ _ _ _ -> False)
            (\x a1 a2 arbol -> case arbol of  
                Hoja _ -> False
                Dos q b1 b2 -> x == q && a1 b1 && a2 b2
                Tres _ _ _ _ _ -> False)
            (\x y a1 a2 a3 arbol -> case arbol of
                Hoja _ -> False
                Dos _ _ _ -> False
                Tres q w b1 b2 b3 -> x == q && y == w 
                            && a1 b1 && a2 b2 && a3 b3)                 
